{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import GHCJS.DOM
import GHCJS.DOM.Document hiding (click)
import GHCJS.DOM.Element (setAttribute)
import GHCJS.DOM.Node
import GHCJS.DOM.WebGLRenderingContextBase
import GHCJS.DOM.HTMLCanvasElement (getContext)
import GHCJS.DOM.Types hiding (Text)
import Data.FileEmbed (embedFile)
import Data.Text.Encoding (decodeUtf8)
import Data.Text (Text)
import GHCJS.Types

import JavaScript.TypedArray.Internal
import qualified JavaScript.TypedArray as JT
import GHCJS.Marshal
import qualified JavaScript.Array as JA
import Control.Monad
import Data.Coerce (coerce)

doubles2Float32Array :: [Double] -> IO JT.Float32Array
doubles2Float32Array = float32ArrayFrom . JA.fromList <=< mapM toJSVal

main :: IO ()
main = runWebGUI $ \win -> do
  enableInspector win
  Just doc <- webViewGetDomDocument win
  Just body <- getBody doc
  Just canvas <- createElement doc (Just "canvas")
  setAttribute canvas "width" "400"
  setAttribute canvas "height" "400"
  _ <- appendChild body (Just canvas)

  gl <- WebGLRenderingContextBase <$> getContext (coerce canvas) "webgl"

  program <- initShader gl
  aPosition <- fromIntegral <$> getAttribLocation gl program "a_Position"

  let n = 4
      vertics = [-0.5, 0.5, -0.5, -0.5, 0.5, 0.5, 0.5, -0.5]

  vertVal <- doubles2Float32Array vertics

  vbo <- createBuffer gl
  bindBuffer gl ARRAY_BUFFER vbo
  bufferData gl ARRAY_BUFFER (Just . ArrayBuffer . jsval $ vertVal ) STATIC_DRAW
  vertexAttribPointer gl aPosition 2 FLOAT False 0 0
  enableVertexAttribArray gl aPosition

  clearColor gl 0.0 0.0 0.0 1.0
  clear gl COLOR_BUFFER_BIT
  drawArrays gl TRIANGLE_STRIP 0 n

vertShaderSource :: Text
vertShaderSource = decodeUtf8 $(embedFile "shader/graph.vert")

fragShaderSource :: Text
fragShaderSource = decodeUtf8 $(embedFile "shader/graph.frag")

initShader :: IsWebGLRenderingContextBase self => self -> IO (Maybe WebGLProgram)
initShader gl = do
  frg <- createShader gl FRAGMENT_SHADER
  shaderSource gl frg fragShaderSource
  compileShader gl frg

  vert <- createShader gl VERTEX_SHADER
  shaderSource gl vert vertShaderSource
  compileShader gl vert

  prog <- createProgram gl
  attachShader gl prog frg
  attachShader gl prog vert
  linkProgram gl prog
  useProgram gl prog
  return prog
